home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / edmacro.el < prev    next >
Lisp/Scheme  |  1993-03-18  |  22KB  |  654 lines
  1. ;;; edmacro.el --- keyboard macro editor
  2.  
  3. ;; Copyright (C) 1990 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Dave Gillespie <daveg@csvax.caltech.edu>
  6. ;; Maintainer: FSF
  7. ;; Version: 1.02
  8. ;; Keywords: abbrev
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; To use, type `M-x edit-last-kbd-macro' to edit the most recently
  29. ;; defined keyboard macro.  If you have used `M-x name-last-kbd-macro'
  30. ;; to give a keyboard macro a name, type `M-x edit-kbd-macro' to edit
  31. ;; the macro by name.  When you are done editing, type `C-c C-c' to
  32. ;; record your changes back into the original keyboard macro.
  33.  
  34. ;;; Code:
  35.  
  36. ;;; The user-level commands for editing macros.
  37.  
  38. ;;;###autoload
  39. (defun edit-last-kbd-macro (&optional prefix buffer hook)
  40.   "Edit the most recently defined keyboard macro."
  41.   (interactive "P")
  42.   (edmacro-edit-macro last-kbd-macro
  43.               (function (lambda (x arg) (setq last-kbd-macro x)))
  44.               prefix buffer hook))
  45.  
  46. ;;;###autoload
  47. (defun edit-kbd-macro (cmd &optional prefix buffer hook in-hook out-hook)
  48.   "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'.
  49. \(See also `edit-last-kbd-macro'.)"
  50.   (interactive "CCommand name: \nP")
  51.   (and cmd
  52.        (edmacro-edit-macro (if in-hook
  53.                    (funcall in-hook cmd)
  54.                  (symbol-function cmd))
  55.                (or out-hook
  56.                    (list 'lambda '(x arg)
  57.                      (list 'fset
  58.                        (list 'quote cmd)
  59.                        'x)))
  60.                prefix buffer hook cmd)))
  61.  
  62. ;;;###autoload
  63. (defun read-kbd-macro (start end)
  64.   "Read the region as a keyboard macro definition.
  65. The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
  66. The resulting macro is installed as the \"current\" keyboard macro.
  67.  
  68. Symbols:  RET, SPC, TAB, DEL, LFD, NUL; C-key; M-key.  (Must be uppercase.)
  69.           REM marks the rest of a line as a comment.
  70.           Whitespace is ignored; other characters are copied into the macro."
  71.   (interactive "r")
  72.   (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))
  73.   (if (and (string-match "\\`\C-x(" last-kbd-macro)
  74.        (string-match "\C-x)\\'" last-kbd-macro))
  75.       (setq last-kbd-macro (substring last-kbd-macro 2 -2))))
  76.  
  77. ;;; Formatting a keyboard macro as human-readable text.
  78.  
  79. (defun edmacro-print-macro (macro-str local-map)
  80.   (let ((save-map (current-local-map))
  81.     (print-escape-newlines t)
  82.     key-symbol key-str key-last prefix-arg this-prefix)
  83.     (unwind-protect
  84.     (progn
  85.       (use-local-map local-map)
  86.       (while (edmacro-peek-char)
  87.         (edmacro-read-key)
  88.         (setq this-prefix prefix-arg)
  89.         (or (memq key-symbol '(digit-argument
  90.                    negative-argument
  91.                    universal-argument))
  92.         (null prefix-arg)
  93.         (progn
  94.           (cond ((consp prefix-arg)
  95.              (insert (format "prefix-arg (%d)\n"
  96.                      (car prefix-arg))))
  97.             ((eq prefix-arg '-)
  98.              (insert "prefix-arg -\n"))
  99.             ((numberp prefix-arg)
  100.              (insert (format "prefix-arg %d\n" prefix-arg))))
  101.           (setq prefix-arg nil)))
  102.         (cond ((null key-symbol)
  103.            (insert "type \"")
  104.            (edmacro-insert-string macro-str)
  105.            (insert "\"\n")
  106.            (setq macro-str ""))
  107.           ((eq key-symbol 'digit-argument)
  108.            (edmacro-prefix-arg key-last nil prefix-arg))
  109.           ((eq key-symbol 'negative-argument)
  110.            (edmacro-prefix-arg ?- nil prefix-arg))
  111.           ((eq key-symbol 'universal-argument)
  112.            (let* ((c-u 4) (argstartchar key-last)
  113.               (char (edmacro-read-char)))
  114.              (while (= char argstartchar)
  115.                (setq c-u (* 4 c-u)
  116.                  char (edmacro-read-char)))
  117.              (edmacro-prefix-arg char c-u nil)))
  118.           ((eq key-symbol 'self-insert-command)
  119.            (insert "insert ")
  120.            (if (and (>= key-last 32) (<= key-last 126))
  121.                (let ((str ""))
  122.              (while (or (and (eq key-symbol
  123.                          'self-insert-command)
  124.                      (< (length str) 60)
  125.                      (>= key-last 32)
  126.                      (<= key-last 126))
  127.                     (and (memq key-symbol
  128.                            '(backward-delete-char
  129.                          delete-backward-char
  130.                          backward-delete-char-untabify))
  131.                      (> (length str) 0)))
  132.                (if (eq key-symbol 'self-insert-command)
  133.                    (setq str (concat str
  134.                          (char-to-string key-last)))
  135.                  (setq str (substring str 0 -1)))
  136.                (edmacro-read-key))
  137.              (insert "\"" str "\"\n")
  138.              (edmacro-unread-chars key-str))
  139.              (insert "\"")
  140.              (edmacro-insert-string (char-to-string key-last))
  141.              (insert "\"\n")))
  142.           ((and (eq key-symbol 'quoted-insert)
  143.             (edmacro-peek-char))
  144.            (insert "quoted-insert\n")
  145.            (let ((ch (edmacro-read-char))
  146.              ch2)
  147.              (if (and (>= ch ?0) (<= ch ?7))
  148.              (progn
  149.                (setq ch (- ch ?0)
  150.                  ch2 (edmacro-read-char))
  151.                (if ch2
  152.                    (if (and (>= ch2 ?0) (<= ch2 ?7))
  153.                    (progn
  154.                      (setq ch (+ (* ch 8) (- ch2 ?0))
  155.                        ch2 (edmacro-read-char))
  156.                      (if ch2
  157.                      (if (and (>= ch2 ?0) (<= ch2 ?7))
  158.                          (setq ch (+ (* ch 8) (- ch2 ?0)))
  159.                        (edmacro-unread-chars ch2))))
  160.                  (edmacro-unread-chars ch2)))))
  161.              (if (or (and (>= ch ?0) (<= ch ?7))
  162.                  (< ch 32) (> ch 126))
  163.              (insert (format "type \"\\%03o\"\n" ch))
  164.                (insert "type \"" (char-to-string ch) "\"\n"))))
  165.           ((memq key-symbol '(isearch-forward
  166.                       isearch-backward
  167.                       isearch-forward-regexp
  168.                       isearch-backward-regexp))
  169.            (insert (symbol-name key-symbol) "\n")
  170.            (edmacro-isearch-argument))
  171.           ((eq key-symbol 'execute-extended-command)
  172.            (edmacro-read-argument obarray 'commandp))
  173.           (t
  174.            (let ((cust (get key-symbol 'edmacro-print)))
  175.              (if cust
  176.              (funcall cust)
  177.                (insert (symbol-name key-symbol))
  178.                (indent-to 30)
  179.                (insert " # ")
  180.                (edmacro-insert-string key-str)
  181.                (insert "\n")
  182.                (let ((int (edmacro-get-interactive key-symbol)))
  183.              (if (string-match "\\`\\*" int)
  184.                  (setq int (substring int 1)))
  185.              (while (> (length int) 0)
  186.                (cond ((= (aref int 0) ?a)
  187.                   (edmacro-read-argument
  188.                    obarray nil))
  189.                  ((memq (aref int 0) '(?b ?B ?D ?f ?F ?n
  190.                               ?s ?S ?x ?X))
  191.                   (edmacro-read-argument))
  192.                  ((and (= (aref int 0) ?c)
  193.                        (edmacro-peek-char))
  194.                   (insert "type \"")
  195.                   (edmacro-insert-string
  196.                    (char-to-string
  197.                     (edmacro-read-char)))
  198.                   (insert "\"\n"))
  199.                  ((= (aref int 0) ?C)
  200.                   (edmacro-read-argument
  201.                    obarray 'commandp))
  202.                  ((= (aref int 0) ?k)
  203.                   (edmacro-read-key)
  204.                   (if key-symbol
  205.                       (progn
  206.                     (insert "type \"")
  207.                     (edmacro-insert-string key-str)
  208.                     (insert "\"\n"))
  209.                     (edmacro-unread-chars key-str)))
  210.                  ((= (aref int 0) ?N)
  211.                   (or this-prefix
  212.                       (edmacro-read-argument)))
  213.                  ((= (aref int 0) ?v)
  214.                   (edmacro-read-argument
  215.                    obarray 'user-variable-p)))
  216.                (let ((nl (string-match "\n" int)))
  217.                  (setq int (if nl
  218.                        (substring int (1+ nl))
  219.                      "")))))))))))
  220.       (use-local-map save-map))))
  221.  
  222. (defun edmacro-prefix-arg (char c-u value)
  223.   (let ((sign 1))
  224.     (if (and (numberp value) (< value 0))
  225.     (setq sign -1 value (- value)))
  226.     (if (eq value '-)
  227.     (setq sign -1 value nil))
  228.     (while (and char (= ?- char))
  229.       (setq sign (- sign) c-u nil)
  230.       (setq char (edmacro-read-char)))
  231.     (while (and char (>= char ?0) (<= char ?9))
  232.       (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)) c-u nil)
  233.       (setq char (edmacro-read-char)))
  234.     (setq prefix-arg
  235.       (cond (c-u (list c-u))
  236.         ((numberp value) (* value sign))
  237.         ((= sign -1) '-)))
  238.     (edmacro-unread-chars char)))
  239.  
  240. (defun edmacro-insert-string (str)
  241.   (let ((i 0) j ch)
  242.     (while (< i (length str))
  243.       (if (and (> (setq ch (aref str i)) 127)
  244.            (< ch 160))
  245.       (progn
  246.         (setq ch (- ch 128))
  247.         (insert "\\M-")))
  248.       (if (< ch 32)
  249.       (cond ((= ch 8)  (insret "\\b"))
  250.         ((= ch 9)  (insert "\\t"))
  251.         ((= ch 10) (insert "\\n"))
  252.         ((= ch 13) (insert "\\r"))
  253.         ((= ch 27) (insert "\\e"))
  254.         (t (insert "\\C-" (char-to-string (downcase (+ ch 64))))))
  255.     (if (< ch 127)
  256.         (if (or (= ch 34) (= ch 92))
  257.         (insert "\\" (char-to-string ch))
  258.           (setq j i)
  259.           (while (and (< (setq i (1+ i)) (length str))
  260.               (>= (setq ch (aref str i)) 32)
  261.               (/= ch 34) (/= ch 92)
  262.               (< ch 127)))
  263.           (insert (substring str j i))
  264.           (setq i (1- i)))
  265.       (if (memq ch '(127 255))
  266.           (insert (format "\\%03o" ch))
  267.         (insert "\\M-" (char-to-string (- ch 128))))))
  268.       (setq i (1+ i)))))
  269.  
  270. (defun edmacro-lookup-key (map)
  271.   (let ((loc (and map (lookup-key map macro-str)))
  272.     (glob (lookup-key (current-global-map) macro-str))
  273.     (loc-str macro-str)
  274.     (glob-str macro-str))
  275.     (and (integerp loc)
  276.      (setq loc-str (substring macro-str 0 loc)
  277.            loc (lookup-key map loc-str)))
  278.     (and (consp loc)
  279.      (setq loc nil))
  280.     (or loc
  281.     (setq loc-str ""))
  282.     (and (integerp glob)
  283.      (setq glob-str (substring macro-str 0 glob)
  284.            glob (lookup-key (current-global-map) glob-str)))
  285.     (and (consp glob)
  286.      (setq glob nil))
  287.     (or glob
  288.     (setq glob-str ""))
  289.     (if (> (length glob-str) (length loc-str))
  290.     (setq key-symbol glob
  291.           key-str glob-str)
  292.       (setq key-symbol loc
  293.         key-str loc-str))
  294.     (setq key-last (and (> (length key-str) 0)
  295.             (logand (aref key-str (1- (length key-str))) 127)))
  296.     key-symbol))
  297.  
  298. (defun edmacro-read-argument (&optional obarray pred)   ;; currently ignored
  299.   (let ((str "")
  300.     (min-bsp 0)
  301.     (exec (eq key-symbol 'execute-extended-command))
  302.     str-base)
  303.     (while (progn
  304.          (edmacro-lookup-key (current-global-map))
  305.          (or (and (eq key-symbol 'self-insert-command)
  306.               (< (length str) 60))
  307.          (memq key-symbol
  308.                 '(backward-delete-char
  309.                   delete-backward-char
  310.                   backward-delete-char-untabify))
  311.          (eq key-last 9)))
  312.       (setq macro-str (substring macro-str (length key-str)))
  313.       (or (and (eq key-last 9)
  314.            obarray
  315.            (let ((comp (try-completion str obarray pred)))
  316.          (and (stringp comp)
  317.               (> (length comp) (length str))
  318.               (setq str comp))))
  319.       (if (or (eq key-symbol 'self-insert-command)
  320.           (and (or (eq key-last 9)
  321.                (<= (length str) min-bsp))
  322.                (setq min-bsp (+ (length str) (length key-str)))))
  323.           (setq str (concat str key-str))
  324.         (setq str (substring str 0 -1)))))
  325.     (setq str-base str
  326.       str (concat str key-str)
  327.       macro-str (substring macro-str (length key-str)))
  328.     (if exec
  329.     (let ((comp (try-completion str-base obarray pred)))
  330.       (if (if (stringp comp)
  331.           (and (commandp (intern comp))
  332.                (setq str-base comp))
  333.         (commandp (intern str-base)))
  334.           (insert str-base "\n")
  335.         (insert "execute-extended-command\n")
  336.         (insert "type \"")
  337.         (edmacro-insert-string str)
  338.         (insert "\"\n")))
  339.       (if (> (length str) 0)
  340.       (progn
  341.         (insert "type \"")
  342.         (edmacro-insert-string str)
  343.         (insert "\"\n"))))))
  344.  
  345. (defun edmacro-isearch-argument ()
  346.   (let ((str "")
  347.     (min-bsp 0)
  348.     ch)
  349.     (while (and (setq ch (edmacro-read-char))
  350.         (or (<= ch 127) (not search-exit-option))
  351.         (not (eq ch search-exit-char))
  352.         (or (eq ch search-repeat-char)
  353.             (eq ch search-reverse-char)
  354.             (eq ch search-delete-char)
  355.             (eq ch search-yank-word-char)
  356.             (eq ch search-yank-line-char)
  357.             (eq ch search-quote-char)
  358.             (eq ch ?\r)
  359.             (eq ch ?\t)
  360.             (not search-exit-option)
  361.             (and (/= ch 127) (>= ch 32))))
  362.       (if (and (eq ch search-quote-char)
  363.            (edmacro-peek-char))
  364.       (setq str (concat str (char-to-string ch)
  365.                 (char-to-string (edmacro-read-char)))
  366.         min-bsp (length str))
  367.     (if (or (and (< ch 127) (>= ch 32))
  368.         (eq ch search-yank-word-char)
  369.         (eq ch search-yank-line-char)
  370.         (and (or (not (eq ch search-delete-char))
  371.              (<= (length str) min-bsp))
  372.              (setq min-bsp (1+ (length str)))))
  373.         (setq str (concat str (char-to-string ch)))
  374.       (setq str (substring str 0 -1)))))
  375.     (if (eq ch search-exit-char)
  376.     (if (= (length str) 0)  ;; non-incremental search
  377.         (progn
  378.           (setq str (concat str (char-to-string ch)))
  379.           (and (eq (edmacro-peek-char) ?\C-w)
  380.            (progn
  381.              (setq str (concat str "\C-w"))
  382.              (edmacro-read-char)))
  383.           (if (> (length str) 0)
  384.           (progn
  385.             (insert "type \"")
  386.             (edmacro-insert-string str)
  387.             (insert "\"\n")))
  388.           (edmacro-read-argument)
  389.           (setq str "")))
  390.       (edmacro-unread-chars ch))
  391.     (if (> (length str) 0)
  392.     (progn
  393.       (insert "type \"")
  394.       (edmacro-insert-string str)
  395.       (insert "\\e\"\n")))))
  396.  
  397. ;;; Get the next keystroke-sequence from the input stream.
  398. ;;; Sets key-symbol, key-str, and key-last as a side effect.
  399. (defun edmacro-read-key ()
  400.   (edmacro-lookup-key (current-local-map))
  401.   (and key-symbol
  402.        (setq macro-str (substring macro-str (length key-str)))))
  403.  
  404. (defun edmacro-peek-char ()
  405.   (and (> (length macro-str) 0)
  406.        (aref macro-str 0)))
  407.  
  408. (defun edmacro-read-char ()
  409.   (and (> (length macro-str) 0)
  410.        (prog1
  411.        (aref macro-str 0)
  412.      (setq macro-str (substring macro-str 1)))))
  413.  
  414. (defun edmacro-unread-chars (chars)
  415.   (and (integerp chars)
  416.        (setq chars (char-to-string chars)))
  417.   (and chars
  418.        (setq macro-str (concat chars macro-str))))
  419.  
  420. (defun edmacro-dump (mac)
  421.   (set-mark-command nil)
  422.   (insert "\n\n")
  423.   (edmacro-print-macro mac (current-local-map)))
  424.  
  425. ;;; Parse a string of spelled-out keystrokes, as produced by key-description.
  426.  
  427. (defun edmacro-parse-keys (str)
  428.   (let ((pos 0)
  429.     (mac "")
  430.     part)
  431.     (while (and (< pos (length str))
  432.         (string-match "[^ \t\n]+" str pos))
  433.       (setq pos (match-end 0)
  434.         part (substring str (match-beginning 0) (match-end 0))
  435.         mac (concat mac
  436.             (if (and (> (length part) 2)
  437.                  (= (aref part 1) ?-)
  438.                  (= (aref part 0) ?M))
  439.                 (progn
  440.                   (setq part (substring part 2))
  441.                   "\e")
  442.               (if (and (> (length part) 4)
  443.                    (= (aref part 0) ?C)
  444.                    (= (aref part 1) ?-)
  445.                    (= (aref part 2) ?M)
  446.                    (= (aref part 3) ?-))
  447.                   (progn
  448.                 (setq part (concat "C-" (substring part 4)))
  449.                 "\e")
  450.                 ""))
  451.             (or (cdr (assoc part '( ( "NUL" . "\0" )
  452.                         ( "RET" . "\r" )
  453.                         ( "LFD" . "\n" )
  454.                         ( "TAB" . "\t" )
  455.                         ( "ESC" . "\e" )
  456.                         ( "SPC" . " " )
  457.                         ( "DEL" . "\177" )
  458.                         ( "C-?" . "\177" )
  459.                         ( "C-2" . "\0" )
  460.                         ( "C-SPC" . "\0") )))
  461.                 (and (equal part "REM")
  462.                  (setq pos (or (string-match "\n" str pos)
  463.                            (length str)))
  464.                  "")
  465.                 (and (= (length part) 3)
  466.                  (= (aref part 0) ?C)
  467.                  (= (aref part 1) ?-)
  468.                  (char-to-string (logand (aref part 2) 31)))
  469.                 part))))
  470.     mac))
  471.  
  472. ;;; Parse a keyboard macro description in edmacro-print-macro's format.
  473.  
  474. (defun edmacro-read-macro (&optional map)
  475.   (or map (setq map (current-local-map)))
  476.   (let ((macro-str ""))
  477.     (while (not (progn
  478.           (skip-chars-forward " \t\n")
  479.           (eobp)))
  480.       (cond ((looking-at "#"))   ;; comment
  481.         ((looking-at "prefix-arg[ \t]*-[ \t]*\n")
  482.          (edmacro-append-chars "\C-u-"))
  483.         ((looking-at "prefix-arg[ \t]*\\(-?[0-9]+\\)[ \t]*\n")
  484.          (edmacro-append-chars (concat "\C-u" (edmacro-match-string 1))))
  485.         ((looking-at "prefix-arg[ \t]*(\\([0-9]+\\))[ \t]*\n")
  486.          (let ((val (string-to-int (edmacro-match-string 1))))
  487.            (while (> val 1)
  488.          (or (= (% val 4) 0)
  489.              (error "Bad prefix argument value"))
  490.          (edmacro-append-chars "\C-u")
  491.          (setq val (/ val 4)))))
  492.         ((looking-at "prefix-arg")
  493.          (error "Bad prefix argument syntax"))
  494.         ((looking-at "insert ")
  495.          (forward-char 7)
  496.          (edmacro-append-chars (read (current-buffer)))
  497.          (if (< (current-column) 7)
  498.          (forward-line -1)))
  499.         ((looking-at "type ")
  500.          (forward-char 5)
  501.          (edmacro-append-chars (read (current-buffer)))
  502.          (if (< (current-column) 5)
  503.          (forward-line -1)))
  504.         ((looking-at "keys \\(.*\\)\n")
  505.          (goto-char (1- (match-end 0)))
  506.          (edmacro-append-chars (edmacro-parse-keys
  507.                     (buffer-substring (match-beginning 1)
  508.                               (match-end 1)))))
  509.         ((looking-at "\\([-a-zA-z0-9_]+\\)[ \t]*\\(.*\\)\n")
  510.          (let* ((func (intern (edmacro-match-string 1)))
  511.             (arg (edmacro-match-string 2))
  512.             (cust (get func 'edmacro-read)))
  513.            (if cust
  514.            (funcall cust arg)
  515.          (or (commandp func)
  516.              (error "Not an Emacs command"))
  517.          (or (equal arg "")
  518.              (string-match "\\`#" arg)
  519.              (error "Unexpected argument to command"))
  520.          (let ((keys
  521.             (or (where-is-internal func map t)
  522.                 (where-is-internal func (current-global-map) t))))
  523.            (if keys
  524.                (edmacro-append-chars keys)
  525.              (edmacro-append-chars (concat "\ex"
  526.                            (symbol-name func)
  527.                            "\n")))))))
  528.         (t (error "Syntax error")))
  529.       (forward-line 1))
  530.     macro-str))
  531.  
  532. (defun edmacro-append-chars (chars)
  533.   (setq macro-str (concat macro-str chars)))
  534.  
  535. (defun edmacro-match-string (n)
  536.   (if (match-beginning n)
  537.       (buffer-substring (match-beginning n) (match-end n))
  538.     ""))
  539.  
  540. (defun edmacro-get-interactive (func)
  541.   (if (symbolp func)
  542.       (let ((cust (get func 'edmacro-interactive)))
  543.     (if cust
  544.         cust
  545.       (edmacro-get-interactive (symbol-function func))))
  546.     (or (and (eq (car-safe func) 'lambda)
  547.          (let ((int (if (consp (nth 2 func))
  548.                 (nth 2 func)
  549.               (nth 3 func))))
  550.            (and (eq (car-safe int) 'interactive)
  551.             (stringp (nth 1 int))
  552.             (nth 1 int))))
  553.     "")))
  554.  
  555. (put 'search-forward           'edmacro-interactive "s")
  556. (put 'search-backward          'edmacro-interactive "s")
  557. (put 'word-search-forward      'edmacro-interactive "s")
  558. (put 'word-search-backward     'edmacro-interactive "s")
  559. (put 're-search-forward        'edmacro-interactive "s")
  560. (put 're-search-backward       'edmacro-interactive "s")
  561. (put 'switch-to-buffer         'edmacro-interactive "B")
  562. (put 'kill-buffer              'edmacro-interactive "B")
  563. (put 'rename-buffer            'edmacro-interactive "B\nB")
  564. (put 'goto-char                'edmacro-interactive "N")
  565. (put 'global-set-key           'edmacro-interactive "k\nC")
  566. (put 'global-unset-key         'edmacro-interactive "k")
  567. (put 'local-set-key            'edmacro-interactive "k\nC")
  568. (put 'local-unset-key          'edmacro-interactive "k")
  569.  
  570. ;;; Think about kbd-macro-query
  571.  
  572. ;;; Edit a keyboard macro in another buffer.
  573. ;;; (Prefix argument is currently ignored.)
  574.  
  575. (defun edmacro-edit-macro (mac repl &optional prefix buffer hook arg)
  576.   (or (stringp mac)
  577.       (error "Not a keyboard macro"))
  578.   (let ((oldbuf (current-buffer))
  579.     (local (current-local-map))
  580.     (buf (get-buffer-create (or buffer "*Edit Macro*"))))
  581.     (set-buffer buf)
  582.     (kill-all-local-variables)
  583.     (use-local-map edmacro-mode-map)
  584.     (setq buffer-read-only nil
  585.       major-mode 'edmacro-mode
  586.       mode-name "Edit Macro")
  587.     (set (make-local-variable 'edmacro-original-buffer) oldbuf)
  588.     (set (make-local-variable 'edmacro-replace-function) repl)
  589.     (set (make-local-variable 'edmacro-replace-argument) arg)
  590.     (set (make-local-variable 'edmacro-finish-hook) hook)
  591.     (erase-buffer)
  592.     (insert "# Keyboard Macro Editor.  Press C-c C-c to finish; press C-x k RET to cancel.\n")
  593.     (insert "# Original keys: " (key-description mac) "\n\n")
  594.     (message "Formatting keyboard macro...")
  595.     (edmacro-print-macro mac local)
  596.     (switch-to-buffer buf)
  597.     (goto-char (point-min))
  598.     (forward-line 3)
  599.     (recenter '(4))
  600.     (set-buffer-modified-p nil)
  601.     (message "Formatting keyboard macro...done")
  602.     (run-hooks 'edmacro-format-hook)))
  603.  
  604. (defun edmacro-finish-edit ()
  605.   (interactive)
  606.   (or (and (boundp 'edmacro-original-buffer)
  607.        (boundp 'edmacro-replace-function)
  608.        (boundp 'edmacro-replace-argument)
  609.        (boundp 'edmacro-finish-hook)
  610.        (eq major-mode 'edmacro-mode))
  611.       (error "This command is valid only in buffers created by `edit-kbd-macro'."))
  612.   (let ((buf (current-buffer))
  613.     (str (buffer-string))
  614.     (func edmacro-replace-function)
  615.     (arg edmacro-replace-argument)
  616.     (hook edmacro-finish-hook))
  617.     (goto-char (point-min))
  618.     (run-hooks 'edmacro-compile-hook)
  619.     (and (buffer-modified-p)
  620.      func
  621.      (progn
  622.        (message "Compiling keyboard macro...")
  623.        (let ((mac (edmacro-read-macro
  624.                (and (buffer-name edmacro-original-buffer)
  625.                 (save-excursion
  626.                   (set-buffer edmacro-original-buffer)
  627.                   (current-local-map))))))
  628.          (and (buffer-name edmacro-original-buffer)
  629.           (switch-to-buffer edmacro-original-buffer))
  630.          (funcall func mac arg))
  631.        (message "Compiling keyboard macro...done")))
  632.     (kill-buffer buf)
  633.     (if hook
  634.     (funcall hook arg))))
  635.  
  636. (defun edmacro-mode ()
  637.   "\\<edmacro-mode-map>Keyboard Macro Editing mode.  Press \\[edmacro-finish-edit] to save and exit.
  638. To abort the edit, just kill this buffer with \\[kill-buffer] RET.
  639.  
  640. The keyboard macro is represented as a series of M-x style command names.
  641. Keystrokes which do not correspond to simple M-x commands are written as
  642. \"type\" commands.  When you press \\[edmacro-finish-edit], edmacro converts each command
  643. back into a suitable keystroke sequence; \"type\" commands are converted
  644. directly back into keystrokes."
  645.   (interactive)
  646.   (error "This mode can be enabled only by `edit-kbd-macro' or `edit-last-kbd-macro'."))
  647. (put 'edmacro-mode 'mode-class 'special)
  648.  
  649. (if (boundp 'edmacro-mode-map) ()
  650.   (setq edmacro-mode-map (make-sparse-keymap))
  651.   (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit))
  652.  
  653. ;;; edmacro.el ends here
  654.